home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / ASM / GCMARK.ASM < prev    next >
Encoding:
Assembly Source File  |  1993-06-09  |  7.1 KB  |  272 lines
  1. ;* GCMARK.ASM
  2. ;************************************************************************
  3. ;*                                    *
  4. ;*        PC Scheme/Geneva 4.00 Borland TASM code            *
  5. ;*                                    *
  6. ;* (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT        *
  7. ;* (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva    *
  8. ;*                                    *
  9. ;*----------------------------------------------------------------------*
  10. ;*                                    *
  11. ;*        Mark unused stuff for Garbage collecting        *
  12. ;*                                    *
  13. ;*----------------------------------------------------------------------*
  14. ;*                                    *
  15. ;* Created by: John Jensen        Date: 1985            *
  16. ;* Revision history:                            *
  17. ;* - 18 Jun 92:    Renaissance (Borland Compilers, ...)            *
  18. ;*                                    *
  19. ;*                    ``In nomine omnipotentii dei''    *
  20. ;************************************************************************
  21. IDEAL
  22. %PAGESIZE    60, 132
  23. MODEL    medium
  24. LOCALS    @@
  25.  
  26.     INCLUDE    "scheme.ash"
  27.  
  28. CODESEG
  29.  
  30. ;************************************************************************
  31. ;*            gcmark entry point                *
  32. ;************************************************************************
  33. PROC C    gcmark    USES si di, $$pagenumber, $$displacement
  34.     mov    bx, [$$pagenumber]
  35.     mov    ax, bx
  36.     mov    si, [$$displacement]    ; pointer gonna be in es:si
  37.     call    $$markrecurse
  38.     ret
  39.  
  40. PROC NOLANGUAGE    $$markrecurse    NEAR
  41.     cmp    bx, DEDPAGES*2    ; check for non-gc'ed pages
  42.     jge    @@domark
  43.     ret
  44.  
  45. @@domark:
  46.     push    ax            ; Preserve the page number
  47.     test    bx, 0ff01h        ; valid pointer?
  48.     jnz    @@badpointer
  49.     ldpage    es, bx
  50.     mov    ax, bx            ; Use ax to store page number
  51.     mov    di, [WORD ptype+bx]    ; load data type*2
  52.     cmp    di, NUMTYPES*2        ; valid page type?
  53.     jae    @@badpointer
  54.     jmp    [@@table+di]
  55. DATASEG
  56. @@table    DW    @@list            ; [0] List cells
  57.     DW    @@fixnum        ; [1] Fixnums
  58.     DW    @@flonum        ; [2] Flonums
  59.     DW    @@bignum        ; [3] Bignums
  60.     DW    @@symbol        ; [4] Symbols
  61.     DW    @@string        ; [5] Strings
  62.     DW    @@array            ; [6] Arrays
  63.     DW    @@continuation        ; [7] Continuations
  64.     DW    @@closure        ; [8] Closures
  65.     DW    @@free            ; [9] Free page
  66.     DW    @@code            ; [10] Code page
  67.     DW    @@inline        ; [11] Inline code
  68.     DW    @@port            ; [12] Port data objects
  69.     DW    @@char            ; [13] Characters
  70.     DW    @@environment        ; [14] Environments
  71. CODESEG
  72.  
  73. @@badpointer:
  74. @@fixnum:
  75. @@char:
  76. @@free:
  77.     push    ax
  78.     lea    ax, [@@msg]
  79. DATASEG
  80. @@msg    DB    "[VM INTERNAL ERROR] gcmark: invalid pointer: %x:%04x (from %x:%04x)", LF, 0
  81. CODESEG
  82.     call    zprintf C, ax, bx, si, [$$pagenumber], [$$displacement]
  83.     call    force_debug C        ; go into debug mode
  84.     pop    ax
  85.     jmp    @@exit
  86.  
  87. @@port:                    ; Process symbol or port
  88. @@symbol:
  89.     test    [(SYMDEF es:si).gc], GC_BIT
  90.     jz    @@symbolcontinue
  91.     jmp    @@exit
  92. @@symbolcontinue:
  93.     or    [(SYMDEF es:si).gc], GC_BIT
  94.     mov    bl, [(SYMDEF es:si).link.page]
  95.     mov    si, [(SYMDEF es:si).link.disp]
  96.     pop    ax            ; restore saved page number
  97.     ldpage    es, ax
  98.     jmp    $$markrecurse        ; make a tail recursive call to gcmark
  99.  
  100. @@list:                    ; Process List Cell
  101.     test    [(LISTDEF es:si).gc], GC_BIT
  102.     jnz    @@exit
  103.     mov    bl, [(LISTDEF es:si).car.page]
  104.     or    [(LISTDEF es:si).gc], GC_BIT
  105.     cmp    bx, DEDPAGES*2        ; check for non-gc'ed pages
  106.     jl    @@cardone
  107.  
  108.     push    ax bx            ; Test for stack overflow
  109.     call    checkstack C
  110.     pop    bx ax
  111.  
  112.     push    si            ; list offset
  113.     mov    si, [(LISTDEF es:si).car.disp]
  114.     and    bl, NOT GC_BIT
  115.     call    @@domark
  116.     pop    si            ; list offset
  117. @@cardone:
  118.     mov    bl, [(LISTDEF es:si).cdr.page]
  119.     mov    si, [(LISTDEF es:si).cdr.disp]
  120.     pop    ax            ; restore saved page
  121.     ldpage    es, ax
  122.     jmp    $$markrecurse        ; call gcmark tail recursively
  123.  
  124. @@flonum:                ; ref to var. length data object or flonum
  125. @@bignum:
  126. @@string:
  127. @@inline:
  128.     or    [(ANYDEF es:si).gc], GC_BIT
  129. @@exit:
  130.     pop    ax            ; restore saved page
  131.     ldpage    es, ax
  132.     ret
  133.  
  134. @@code:                    ; Process Code Block
  135.     test    [(CODEDEF es:si).gc], GC_BIT
  136.     jnz    @@exit
  137.     or    [(CODEDEF es:si).gc], GC_BIT
  138.     mov    cx, [(CODEDEF es:si).entry.val]; load entry point offset as counter
  139.     jmp    @@testandloop
  140.  
  141. @@array:                ; process Variable Length Object Containing Pointers
  142. @@closure:
  143. @@continuation:
  144. @@environment:
  145.     test    [(ANYDEF es:si).gc], GC_BIT
  146.     jnz    @@exit
  147.     or    [(ANYDEF es:si).gc], GC_BIT
  148.     mov    cx, [(ANYDEF es:si).len]
  149.     cmp    cx, SIZE POINTER    ; test for zero length vector
  150.     jle    @@exit
  151. @@testandloop:                ; test for stack overflow
  152.     push    ax
  153.     call    checkstack C
  154.     pop    ax
  155. @@loop:
  156.     add    si, SIZE POINTER    ; Increment address for next pointer
  157.     push    cx si            ; Save counter & current offset
  158.     mov    bl, [(POINTER es:si).page]
  159.     mov    si, [(POINTER es:si).disp]
  160.     call    $$markrecurse
  161.     pop    si cx            ; Restore current offset & counter
  162.     sub    cx, SIZE POINTER
  163.     cmp    cx, SIZE POINTER    ; test for completion
  164.     jg    @@loop
  165.     jmp    @@exit
  166. ENDP    $$markrecurse
  167.  
  168. ENDP    gcmark
  169.  
  170. ;************************************************************************
  171. ;*            sum_space                    *
  172. ;************************************************************************
  173. PROC C    sum_space USES si di, @@result
  174.     mov    di, [@@result]
  175.     xor    bx, bx            ; start with zero-th page
  176. @@pageloop:
  177.     xor    ax, ax            ; clear the free space counter
  178.     cmp    bx, DEDPAGES*2
  179.     jl    @@done
  180.     test    [attrib+bx], NOMEMORY    ; is page allocated ?
  181.     jnz    @@done
  182.     cmp    [ptype+bx], FREETYPE    ; is page free ?
  183.     je    @@free
  184.     ldpage    es, bx            ; load current paragraph's base address
  185.     mov    si, [WORD ptype+bx]
  186.     jmp    [@@table+si]        ; branch on page type
  187.  
  188. @@list:
  189.     mov    cx, SIZE LISTDEF
  190. @@linkedlist:
  191.     mov    si, [nextcell+bx]    ; load list cell free storage chain header
  192. @@linkloop:
  193.     cmp    si, END_LIST        ; end of list?
  194.     je    @@done
  195.     add    ax, cx            ; increment the free list cell counter
  196.     jo    @@suckinloop
  197.     mov    si, [(LISTDEF es:si).car.disp]
  198.     jmp    @@linkloop        ; keep following linked list
  199. DATASEG
  200. @@table    DW    @@list            ; [0] List cells
  201.     DW    @@fixnum        ; [1] Fixnums
  202.     DW    @@flonum        ; [2] Flonums
  203.     DW    @@bignum        ; [3] Bignums
  204.     DW    @@symbol        ; [4] Symbols
  205.     DW    @@string        ; [5] Strings
  206.     DW    @@array            ; [6] Arrays
  207.     DW    @@continuation        ; [7] Continuations
  208.     DW    @@closure        ; [8] Closures
  209.     DW    @@free            ; [9] Free page
  210.     DW    @@code            ; [10] Code page
  211.     DW    @@inline        ; [11] Inline code
  212.     DW    @@port            ; [12] Port data objects
  213.     DW    @@char            ; [13] Characters
  214.     DW    @@environment        ; [14] Environments
  215. CODESEG
  216.  
  217. @@bignum:
  218. @@symbol:
  219. @@string:
  220. @@inline:
  221. @@closure:
  222. @@continuation:
  223. @@array:
  224. @@code:
  225. @@port:
  226. @@environment:
  227.     xor    si, si            ; initialize pointer into page
  228.     mov    cx, [psize+bx]
  229.     sub    cx, SIZE POINTER    ; adjust size for page boundary check
  230. @@itemloop:
  231.     cmp    si, cx            ; through with this page?
  232.     ja    @@done
  233.     mov    dx, [(ANYDEF es:si).len]
  234.     or    dx, dx            ; check for small string
  235.     jge    @@bigstr
  236.     mov    dx, OFFSET (TYPE STRDEF).buffer + SIZE POINTER
  237. @@bigstr:
  238.     cmp    [(FREEDEF es:si).tag], FREETYPE
  239.     jne    @@used
  240.     add    ax, dx            ; add in number of free bytes
  241. @@used:
  242.     add    si, dx            ; update pointer to next block
  243.     jmp    @@itemloop
  244. @@free:
  245.     mov    ax, [psize+bx]        ; load size of free page
  246. @@fixnum:
  247. @@char:
  248. @@done:
  249.     mov    [di], ax        ; store number of free bytes (ax)
  250.     add    di, 2            ; increment array index
  251.     add    bx, 2            ; increment page index
  252.     cmp    bx, NUMPAGES*2        ; test for completion
  253.     jl    @@pageloop
  254.     ret
  255.  
  256. @@flonum:
  257.     mov    cx, SIZE FLODEF
  258.     jmp    @@linkedlist
  259.  
  260. @@suckinloop:
  261.     shr    bx, 1
  262.     lea    si, [@@msg]
  263. DATASEG
  264. @@msg    DB    "[VM FATAL ERROR] sumspace: infinite loop page %d", LF, 0
  265. CODESEG
  266.     call    zprintf C, si, bx
  267.     call    force_reset C        ; return to scheme for debug
  268. ENDP    sum_space
  269.  
  270.     END
  271.  
  272.